SetDirectory["C:/drorbn/AcademicPensieve/Projects/Arrow_Diagrams_and_gl(N)"];
<< "Arrow_Diagrams_and_gl(N).m"
base=10;

diag=BasisAArrow[4][[120]]

diag3=BasisAArrow[3][[12]]

UGLnBiAlg[diag3]

U[deg_, diag_] :=Expand[Plus[
UGLnBiAlg[diag] /. n^p_.*RW[l___] :> EW[n^p*FromDigits[{l}, base^2]] //. h[i_]^p_. EW[l_] :> EW[h[i]^p l],
Coproduct[diag, 1] /. T[d1_, d2_] :> Distribute[T[UGLnBiAlg[d1], UGLnBiAlg[d2]]] /.
T[c_?NumberQ * a1_, a2_] :> c*T[a1,a2] /. T[a1_, c_?NumberQ * a2_] :> c*T[a1,a2] /. T[a1_, a2_] :> EW[1, a1, a2],
Coproduct[diag, 2] /. T[d1_, d2_] :> Distribute[T[UGLnBiAlg[d1], UGLnBiAlg[d2]]] /.
T[c_?NumberQ * a1_, a2_] :> c*T[a1,a2] /. T[a1_, c_?NumberQ * a2_] :> c*T[a1,a2] /. T[a1_, a2_] :> EW[2, a1, a2]
]]

U[3, diag3]

vs=U[3, #]&  /@ Diagrams[3ar]

EWs=Union[Cases[vs, _EW, Infinity]]

EWRule=Dispatch[Thread[EWs -> Array[v, {Length[EWs]}]]]

Total[Head/@ vs]

mat = SparseArray[
Join @@ Table[
t=List @@ (vs[[i]] /. EWRule);
Replace[#, c_.*v[j_] :> ({i,j} -> c)]& /@ t,
{i,Length[vs]}
],
{Length[vs], Length[EWs]}
]

MatrixRank[mat]

ds=Take[BasisAArrow[4],2];
vs=Table[
Print[i," ",ds[[i]]];
U[4, ds[[i]]],
{i, Length[ds]}
];
Print["Finding EWs..."];
EWs=Union[Cases[vs, _EW, Infinity]];
EWRule=Dispatch[Thread[EWs -> Array[v, {Length[EWs]}]]];
Print["Computing mat..."];
Print[{Length[vs], Length[EWs]}];
mat = SparseArray[
Join @@ Table[
t=List @@ (vs[[i]] /. EWRule);
Replace[#, c_.*v[j_] :> ({i,j} -> c)]& /@ t,
{i,Length[vs]}
],
{Length[vs], Length[EWs]}
];
Print["Computing Rank..."];
MatrixRank[mat]

ds=Take[BasisAArrow[4],All];
vs=Table[
Print[i," ",ds[[i]]];
U[4, ds[[i]]],
{i, Length[ds]}
];
Print["Finding EWs..."];
EWs=Union[Cases[vs, _EW, Infinity]];
EWRule=Dispatch[Thread[EWs -> Array[v, {Length[EWs]}]]];
Print["Computing mat..."];
Print[{Length[vs], Length[EWs]}];
mat = SparseArray[
Join @@ Table[
t=List @@ (vs[[i]] /. EWRule);
Replace[#, c_.*v[j_] :> ({i,j} -> c)]& /@ t,
{i,Length[vs]}
],
{Length[vs], Length[EWs]}
];
Print["Computing Rank..."];
MatrixRank[mat]